Podsumowanie

Analiza przeprowadzona w tym raporcie koncentrowała się na badaniu zależności między różnymi właściwościami baterii. Główne spostrzeżenia obejmują:

  • Dominującym głównym jonem baterii jest lit, który stanowi 50% wszystkich badanych baterii.
  • Baterie wapniowe mogą być dobrą alternatywą do litowo-jonowych, ponieważ mają dużą gęstość energii (największą z badanych jonów), większą pojemność oraz lepszy wskaźnik stabilności. To powoduje, że mogą one oferować obiecującą wydajność i wyższy poziom bezpieczeństwa.
  • Silne korelacje między parametrami wolumetrycznymi i grawimetrycznymi.
  • Silne korelacje między gęstością energii i pojemnością.
  • Model regresji osiągnął wysoki współczynnik determinacji (R²), co wskazuje na dobrą jakość predykcji gęstości energii wolumetrycznej.

Przeprowadzona analiza może być przydatna w dalszych badaniach oraz w praktycznych zastosowaniach projektowania akumulatorów.

Załadowanie bibliotek

library(dplyr)
library(ggplot2)
library(kableExtra)
library(tidyr)
library(plotly)
library(corrplot)
library(ggcorrplot)
library(caret)

Podstawowe statystyki

  • Rozmiar zbioru danych: 4351 wierszy i 17 kolumn
  • Liczba brakujących wartości: 0

Zbiór nie zawiera pustych wartości

Battery.ID Battery.Formula Working.Ion Formula.Charge Formula.Discharge Max.Delta.Volume Average.Voltage Gravimetric.Capacity Volumetric.Capacity Gravimetric.Energy Volumetric.Energy Atomic.Fraction.Charge Atomic.Fraction.Discharge Stability.Charge Stability.Discharge Steps Max.Voltage.Step
Length:4351 Length:4351 Length:4351 Length:4351 Length:4351 Min. : 0.00002 Min. :-7.755 Min. : 5.176 Min. : 24.08 Min. :-583.5 Min. :-2208.1 Min. :0.00000 Min. :0.007407 Min. :0.00000 Min. :0.00000 Min. :1.000 Min. : 0.0000
Class :character Class :character Class :character Class :character Class :character 1st Qu.: 0.01747 1st Qu.: 2.226 1st Qu.: 88.108 1st Qu.: 311.62 1st Qu.: 211.7 1st Qu.: 821.6 1st Qu.:0.00000 1st Qu.:0.086957 1st Qu.:0.03301 1st Qu.:0.01952 1st Qu.:1.000 1st Qu.: 0.0000
Mode :character Mode :character Mode :character Mode :character Mode :character Median : 0.04203 Median : 3.301 Median : 130.691 Median : 507.03 Median : 401.8 Median : 1463.8 Median :0.00000 Median :0.142857 Median :0.07319 Median :0.04878 Median :1.000 Median : 0.0000
NA NA NA NA NA Mean : 0.37531 Mean : 3.083 Mean : 158.291 Mean : 610.62 Mean : 444.1 Mean : 1664.0 Mean :0.03986 Mean :0.159077 Mean :0.14257 Mean :0.12207 Mean :1.167 Mean : 0.1503
NA NA NA NA NA 3rd Qu.: 0.08595 3rd Qu.: 4.019 3rd Qu.: 187.600 3rd Qu.: 722.75 3rd Qu.: 614.4 3rd Qu.: 2252.3 3rd Qu.:0.04762 3rd Qu.:0.200000 3rd Qu.:0.13160 3rd Qu.:0.09299 3rd Qu.:1.000 3rd Qu.: 0.0000
NA NA NA NA NA Max. :293.19322 Max. :54.569 Max. :2557.627 Max. :7619.19 Max. :5926.9 Max. :18305.9 Max. :0.90909 Max. :0.993333 Max. :6.48710 Max. :6.27781 Max. :6.000 Max. :26.9607

Zawartość zbioru

Battery.ID Battery.Formula Working.Ion Formula.Charge Formula.Discharge Max.Delta.Volume Average.Voltage Gravimetric.Capacity Volumetric.Capacity Gravimetric.Energy Volumetric.Energy Atomic.Fraction.Charge Atomic.Fraction.Discharge Stability.Charge Stability.Discharge Steps Max.Voltage.Step
mp-30_Al Al0-2Cu Al Cu Al2Cu 3.043399 0.0890331 1368.481 5562.790 121.84009 495.27253 0.0 0.6666667 0.0000000 0.0000000 1 0
mp-1022721_Al Al1-3Cu Al AlCu Al3Cu 1.243653 -0.0215863 1112.937 4418.980 -24.02423 -95.38962 0.5 0.7500000 0.0740612 0.0962458 1 0
mp-8637_Al Al0-5Mo Al Mo Al5Mo 4.762574 0.1227568 1741.504 7175.702 213.78156 880.86651 0.0 0.8333333 0.4114601 0.0452120 1 0
mp-129_Al Al0-12Mo Al Mo Al12Mo 12.723893 0.0431214 2298.811 7346.232 99.12801 316.78006 0.0 0.9230769 0.0000000 0.0114456 1 0
mp-91_Al Al0-12W Al W Al12W 12.494598 0.0292342 1900.745 7332.719 55.56677 214.36621 0.0 0.9230769 0.0000000 0.0000000 1 0
mp-1055908_Al Al0-12Mn Al Mn MnAl12 18.236156 0.0397314 2547.693 7592.916 101.22330 301.67688 0.0 0.9230769 0.1454643 0.0000000 1 0

Czyszczenie zbioru danych

Bezwzględne wartości napięcia i energii

W związku z tym, że w baterii płynie prąd stały, do analizy wykorzystano średnią z wartości bezwzględnych napięć i energii zamiast RMS (średniej kwadratowej), która lepiej nadaje się do prądu zmiennego.

W celu ułatwienia dalszej analizy wyznaczono bezwzględną wartość napięć oraz energii. Ujemne wartości oznaczają przeciwną polaryzację napięcia, która nie wpływa na energię zgromadzoną w baterii.

data <- data %>%
  mutate(Average.Voltage = abs(Average.Voltage)) %>%
  mutate(Gravimetric.Energy = abs(Gravimetric.Energy)) %>%
  mutate(Volumetric.Energy = abs(Volumetric.Energy))

Usunięcie wartości odstających

Przed analizą danych konieczne było usunięcie wartości odstających (outliers), ponieważ mogły one zaburzyć analizę i doprowadzić do błędnych wniosków. Zastosowano metodę rozstępu ćwiartkowego (IQR), polegającą na obliczeniu przedziału międzykwartylowego i usunięciu wartości leżących poza tym przedziałem.

\[ \text{Outliers} = \{ x : x > Q3 + threshold \cdot IQR \; \text{or} \; x < Q1 - threshold \cdot IQR \} \] threshold domyślnie jest ustawiony na 1,5.

Uwaga! W przypadku wystąpienia wartości odstającej w danej kolumnie usuwany jest cały wiersz, w którym się ona znajduje. Dzięki temu liczność każdej kolumny pozostaje taka sama. Takie podejście zastosowano, ponieważ analiza obejmuje zależności między atrybutami. Dodatkowo założono, że jeśli wartość jednego atrybutu jest odstająca, to pozostałe atrybuty w tym samym wierszu mogły zostać błędnie wyznaczone.

# Funkcja do oznaczania wierszy z wartościami odstającymi (tylko dla kolumn numerycznych)
remove_outliers_rowwise <- function(data, threshold = 1.5) {
  # Wybierz tylko numeryczne kolumny
  numeric_columns <- sapply(data, is.numeric)

  # Zastosuj funkcję tylko do numerycznych kolumn
  outlier_mask <- apply(data[, numeric_columns, drop = FALSE], 1, function(row) {
    # Sprawdzanie odstających wartości w każdym wierszu
    any(sapply(1:length(row), function(i) {
      col <- names(data)[numeric_columns][i]

      Q1 <- quantile(data[[col]], 0.25)
      Q3 <- quantile(data[[col]], 0.75)
      IQR <- IQR(data[[col]])

      row[col] < (Q1 - threshold * IQR) || row[col] > (Q3 + threshold * IQR)
    }))
  })

  # Zwróć dane bez wierszy z wartościami odstającymi
  data[!outlier_mask, ]
}

cleared_data <- remove_outliers_rowwise(data, 3)
# cleared_data <- data

Threshold musiał zostać zwiększony z 1.5 na 3, ponieważ przy domyślnej wartości prawie połowa zbioru została usunięta.

Liczba usuniętych wierszy przy threshold równym 3: 1218

Ekstrakcja atrybutów numerycznych

Max.Delta.Volume Average.Voltage Gravimetric.Capacity Volumetric.Capacity Gravimetric.Energy Volumetric.Energy Atomic.Fraction.Charge Atomic.Fraction.Discharge Stability.Charge Stability.Discharge Steps Max.Voltage.Step
70 0.0432028 3.5460914 74.742156 296.38931 265.04252 1051.02361 0.0000000 0.1111111 0.0111520 0.0447057 1 0
71 0.0066723 1.6879114 6.539716 35.11148 11.03846 59.26507 0.0545455 0.0714286 0.0000000 0.0000000 1 0
72 0.1070933 1.0948359 109.437374 463.71443 119.81597 507.69120 0.0000000 0.2500000 0.0095215 0.1766371 1 0
73 0.0415262 0.9598099 15.662905 114.64249 15.03341 110.03500 0.0000000 0.0666667 0.0000000 0.0082318 1 0
75 0.0625242 0.8756721 38.559152 179.95435 33.76518 157.58101 0.0000000 0.0666667 0.0000000 0.0221963 1 0
77 0.0383559 1.4088479 28.305532 155.34733 39.87819 218.86076 0.0000000 0.0666667 0.0000000 0.0000000 1 0

Przekształcenie danych do formatu długiego (long format)

Format danych został przekształcony tak, aby każdy atrybut i jego wartości znalazły się w dwóch osobnych kolumnach (Attribute i Value). Dzięki temu możliwe jest łatwiejsze tworzenie wykresów rozkładu wartości.

data_long <- numeric_data %>%
  pivot_longer(cols = everything(), names_to = "Atrybuty", values_to = "Wartości")

data_long
## # A tibble: 37,596 × 2
##    Atrybuty                   Wartości
##    <chr>                         <dbl>
##  1 Max.Delta.Volume             0.0432
##  2 Average.Voltage              3.55  
##  3 Gravimetric.Capacity        74.7   
##  4 Volumetric.Capacity        296.    
##  5 Gravimetric.Energy         265.    
##  6 Volumetric.Energy         1051.    
##  7 Atomic.Fraction.Charge       0     
##  8 Atomic.Fraction.Discharge    0.111 
##  9 Stability.Charge             0.0112
## 10 Stability.Discharge          0.0447
## # ℹ 37,586 more rows

Rozkłady gęstości atrybutów dla każdej kolumny

distribution_plots <- data_long %>%
  ggplot(aes(x = Wartości)) +
  geom_histogram(aes(y = ..density.., 
                     text = paste("Gęstość:", round(..density.., 2), "<br>Wartość:", scales::comma(..x..))),
                 bins = 30, color = "black", alpha = 0.5) + 
  geom_density(color = "red", size = 0.4) +  
  facet_wrap(~ Atrybuty, scales = "free", ncol = 3) +  
  theme_minimal() +
  theme(
    panel.spacing = unit(2, "lines"),
    axis.text.y = element_text(size = 8, margin = margin(r = 5)),
    plot.margin = margin(b = 20, r = 10)
  ) +
  labs(title = "Rozkłady wartości atrybutów", x = "Wartości", y = "Gęstość")

ggplotly(distribution_plots, tooltip = "text") %>%
  layout(hovermode = "x", width = 800)

Analiza wartości atrybutów

Liczba baterii w zależności od głównego jonu

batteries_by_ion <- cleared_data %>%
  group_by(Working.Ion) %>%
  summarize(n = n()) %>%
  arrange(desc(n))

count_batteries_plot <- ggplot(batteries_by_ion, aes(x = reorder(Working.Ion, n), y = n, text = paste("Liczba baterii:", n))) +
  geom_bar(stat = "identity", color = "black") +
  theme_minimal() +
  labs(title = "Liczba baterii w zależności od głównego jonu", x = "Główny jon", y = "Liczba baterii") +
  coord_flip()

ggplotly(count_batteries_plot, tooltip = "text")

Średnie napięcie dla różnych jonów

avg_voltage_by_ion <- cleared_data %>%
  group_by(Working.Ion) %>%
  summarize(avg_voltage = mean(Average.Voltage)) %>%
  arrange(desc(avg_voltage))

avg_voltage_plot <- ggplot(avg_voltage_by_ion, aes(x = reorder(Working.Ion, avg_voltage), y = avg_voltage, 
                                                   text = paste("Średnie napięcie:", round(avg_voltage, 2)))) +
  geom_col(color = "black") +
  theme_minimal() +
  labs(title = "Średnie napięcie dla różnych jonów", x = "Główny jon", y = "Średnie napięcie") +
  coord_flip()

ggplotly(avg_voltage_plot, tooltip = "text")

Porównanie gęstości energii dla każdego jonu

average_energies <- cleared_data %>%
  group_by(Working.Ion) %>%
  summarize(
    avg_gr_energy = mean(Gravimetric.Energy),
    avg_vol_energy = mean(Volumetric.Energy)
  ) %>%
  mutate(total_Energy = avg_gr_energy + avg_vol_energy) %>%
  arrange(desc(avg_vol_energy)) 

data_long <- average_energies %>%
  pivot_longer(
    cols = c(avg_gr_energy, avg_vol_energy),
    names_to = "energy_type",
    values_to = "avg_energy"
  ) %>%
  mutate(
    energy_type = recode(energy_type,
                         avg_gr_energy = "Energia grawimetryczna",
                         avg_vol_energy = "Energia wolumetryczna")
  )

energy_plot <- ggplot(data_long, aes(x = avg_energy, y = reorder(Working.Ion, avg_energy), 
                                     fill = energy_type, text = paste("Średnia gęstość energii:", round(avg_energy, 2)))) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Porównanie średniej wolumetrycznej i grawimetrycznej gęstości energii", 
       x = "Średnia gęstość energii", y = "Główny jon", fill = "Typ gęstości energii") +
    scale_fill_manual(values = c("#6D9EC1", "#E46726") 
  ) +
  theme_minimal()


ggplotly(energy_plot, tooltip = "text")

Porównanie pojemności dla każdego jonu

average_capacities <- cleared_data %>%
  group_by(Working.Ion) %>%
  summarize(
    avg_gr_capacity = mean(Gravimetric.Capacity),
    avg_vol_capacity = mean(Volumetric.Capacity)
  ) %>%
  mutate(total_capacity = avg_gr_capacity + avg_vol_capacity) %>%
  arrange(desc(avg_vol_capacity)) 

data_long_capacity <- average_capacities %>%
  pivot_longer(
    cols = c(avg_gr_capacity, avg_vol_capacity),
    names_to = "capacity_type",
    values_to = "avg_capacity"
  ) %>%
  mutate(
    capacity_type = recode(capacity_type,
                           avg_gr_capacity = "Pojemność grawimetryczna",
                           avg_vol_capacity = "Pojemność wolumetryczna")
  )

capacity_plot <- ggplot(data_long_capacity, aes(x = avg_capacity, y = reorder(Working.Ion, avg_capacity), 
                                                fill = capacity_type, 
                                                text = paste("Średnia pojemność:", round(avg_capacity, 2)))) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Porównanie średniej wolumetrycznej i grawimetrycznej pojemności", 
       x = "Średnia pojemność", y = "Główny jon", fill = "Typ pojemności") +
  scale_fill_manual(values = c("#6D9EC1", "#E46726")) +
  theme_minimal()

ggplotly(capacity_plot, tooltip = "text")

Porównanie udziału atomowego dla każdego jonu

average_fractions <- cleared_data %>%
  group_by(Working.Ion) %>%
  summarize(
    avg_atomic_fraction_charge = mean(Atomic.Fraction.Charge),
    avg_atomic_fraction_discharge = mean(Atomic.Fraction.Discharge)
  ) %>%
  mutate(total_fraction = avg_atomic_fraction_charge + avg_atomic_fraction_discharge) %>%
  arrange(desc(avg_atomic_fraction_discharge)) 

data_long_fractions <- average_fractions %>%
  pivot_longer(
    cols = c(avg_atomic_fraction_charge, avg_atomic_fraction_discharge),
    names_to = "fraction_type",
    values_to = "avg_fraction"
  ) %>%
  mutate(
    fraction_type = recode(fraction_type,
                           avg_atomic_fraction_charge = "Naładowany",
                           avg_atomic_fraction_discharge = "Rozładowany")
  )

fraction_plot <- ggplot(data_long_fractions, aes(x = avg_fraction, y = reorder(Working.Ion, avg_fraction), 
                                                 fill = fraction_type, 
                                                 text = paste("Średni udział atomowy:", round(avg_fraction, 2)))) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Porównanie średnich udziałów atomowych w <br>stanach naładowanym i rozładowanym", 
       x = "Średni udział atomowy", y = "Główny jon", fill = "Stan") +
  scale_fill_manual(values = c("#6D9EC1", "#E46726")) +
  theme_minimal()

ggplotly(fraction_plot, tooltip = "text")

Porównanie wskaźnika stabilności dla każdego jonu

average_stability <- cleared_data %>%
  group_by(Working.Ion) %>%
  summarize(
    avg_stability_charge = mean(Stability.Charge),
    avg_stability_discharge = mean(Stability.Discharge)
  ) %>%
  mutate(total_stability = avg_stability_charge + avg_stability_discharge) %>%
  arrange(desc(avg_stability_discharge)) 

data_long_stability <- average_stability %>%
  pivot_longer(
    cols = c(avg_stability_charge, avg_stability_discharge),
    names_to = "stability_type",
    values_to = "avg_stability"
  ) %>%
  mutate(
    stability_type = recode(stability_type,
                            avg_stability_charge = "Naładowany",
                            avg_stability_discharge = "Rozładowany")
  )

stability_plot <- ggplot(data_long_stability, aes(x = avg_stability, y = reorder(Working.Ion, avg_stability), 
                                                  fill = stability_type, 
                                                  text = paste("Średni wskaźnik stabilności:", round(avg_stability, 2)))) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Porównanie średniego wskaźnika stabilności w <br>stanach naładowanym i rozładowanym", 
       x = "Średni wskaźnik stabilności", y = "Główny jon", fill = "Stan") +
  scale_fill_manual(values = c("#6D9EC1", "#E46726")) +
  theme_minimal()

ggplotly(stability_plot, tooltip = "text")

Analiza korelacji między zmiennymi

Oczekiwana korelacja między pojemnościami

Duża korelacja między pojemnością grawimetryczną (gravimetric capacity) a pojemnością wolumetryczną (volumetric capacity) jest uzasadniona. Wynika to z faktu, że iloraz tych wartości odpowiada gęstości baterii:

\[ \frac{\text{Vc}}{\text{Gc}} = \frac{\text{mAh/cm}^3}{\text{mAh/g}} = \text{gęstość baterii (g/cm}^3\text{)}. \]

Oczekiwana korelacja między energiami

Podobne zależności można zaobserwować między wolumetryczną energią (volumetric energy) a grawimetryczną energią (gravimetric energy). Wysoka korelacja jest tutaj również uzasadniona, ponieważ ich iloraz odpowiada gęstości baterii:

\[ \frac{\text{Ve}}{\text{Ge}} = \frac{\text{Wh/L}}{\text{Wh/kg}} = \text{gęstość baterii (kg/L)}. \]

cor_matrix <- cor(numeric_data, use = "complete.obs")

correlation_plot <- ggcorrplot(
  cor_matrix, 
  hc.order = FALSE, 
  lab = TRUE, 
  type = "lower", 
  lab_size = 2.5,
  outline.col = "white",
  legend.title = "Korelacja",
  colors = c("#6D9EC1", "white", "#E46726")
) +
  theme_minimal(base_size = 10) +
  theme(
    axis.text.x = element_text(size = 8, angle = 45, vjust = 1, hjust = 1),
    axis.text.y = element_text(size = 8)
  ) +
  labs(title = "Analiza korelacji", x = "", y = "")

ggplotly(correlation_plot, tooltip = "text")

Dlaczego oczekiwane współczynniki korelacji nie osiągają wartości 1?

Chociaż współczynnik korelacji między pojemnościami i energiami w bateriach jest wysoki, nie osiąga wartości idealnej, czyli 1. Wynika to z faktu, że na gęstość baterii wpływa wiele czynników, nieograniczających się jedynie do głównego jonu użytego w materiale aktywnym.

Oprócz głównego jonu, istotny udział w gęstości mają pozostałe pierwiastki, takie jak dodatki stabilizujące strukturę materiału, przewodniki jonowe czy inne składniki elektrody. Ich obecność może wpływać zarówno na gęstość masową (g/cm³ lub kg/L), jak i na właściwości elektrochemiczne, takie jak napięcie czy zdolność do przechowywania energii.

Korelacja między pojemnością a energią

Silna korelacja między pojemnością grawimetryczną (gravimetric capacity) a grawimetryczną energią (gravimetric energy) nie była spodziewana. Jednak rzeczywiście można zauważyć, że ich iloraz jest równy wartości napięcia między zaciskami baterii.

Interpretacja współczynnika korelacji \(r\)

Wartości współczynnika korelacji \(r\) interpretuję zgodnie z poniższymi przedziałami:

  • Bardzo silna korelacja: \(0.9 \leq |r| \leq 1\)
  • Silna korelacja: \(0.7 \leq |r| < 0.9\)
  • Umiarkowana korelacja: \(0.5 \leq |r| < 0.7\)
  • Słaba korelacja: \(0.3 \leq |r| < 0.5\)
top_correlations <- function(cor_matrix, threshold = 0.7) {
  cor_matrix[lower.tri(cor_matrix, diag = TRUE)] <- NA
  cor_table <- as.data.frame(as.table(cor_matrix))
  cor_table <- cor_table[!is.na(cor_table$Freq) & abs(cor_table$Freq) >= threshold, ]
  cor_table <- cor_table[order(-abs(cor_table$Freq)), ] 
  cor_table %>%
    rename('Atrybut 1' = Var1, 'Atrybut 2' = Var2, 'Współczynnik korelacji' = Freq)
}

knitr::kable(top_correlations(cor_matrix, 0.7), caption = "Tabela silnych i bardzo silnych korelacji") %>%
  kable_styling(bootstrap_options = "striped", full_width = T)
Tabela silnych i bardzo silnych korelacji
Atrybut 1 Atrybut 2 Współczynnik korelacji
65 Gravimetric.Energy Volumetric.Energy 0.9052481
39 Gravimetric.Capacity Volumetric.Capacity 0.8710103
63 Gravimetric.Capacity Volumetric.Energy 0.7408972
51 Gravimetric.Capacity Gravimetric.Energy 0.7265697
64 Volumetric.Capacity Volumetric.Energy 0.7040137

Predykcja gęstości energii

W tej sekcji przedstawiono proces predykcji energii wolumetrycznej (Volumetric.Energy) na podstawie innych kluczowych atrybutów baterii. Do modelu użyto danych po usunięciu wartości odstających.

Wykorzystano model regresji liniowej, który został stworzony przy użyciu zbioru treningowego (80% danych). Zbiór testowy (20%) posłużył do oceny skuteczności predykcji.

Do oceny jakości modelu wykorzystano następujące metryki:

  • RMSE (Root Mean Square Error) - średnia odległość pomiędzy wartościami przewidywanymi a rzeczywistymi. Im mniejsza, tym lepiej
  • MAE (Mean Absolute Error) - średnia bezwzględna różnica między rzeczywistymi a przewidywanymi wartościami. Im mniejsza tym lepiej
  • R² (współczynnik determinacji) - wskaźnik, który mówi, jak dobrze model dopasowuje się do danych (od 0 do 1, gdzie 1 oznacza idealne dopasowanie). Wykorzystany został współczynnik korelacji r-Pearsona podniesiony do kwadratu.

Dobór zmiennych do modelu

Analiza korelacji pomiędzy cechami ujawniła silne zależności między Volumetric.Energy a innymi atrybutami, co wymagało starannego doboru zmiennych do modelu. Z tego względu cecha Gravimetric.Energy została uwzględniona w modelu (r = 0.91). Natomiast z modelu wyłączono Gravimetric.Capacity i Volumetric.Capacity, ponieważ są one redundantne i mogą powodować problemy z multikolinearnością.

Po licznych próbach doboru najlepszych zmiennych końcowo do modelu włączono:

  • Gravimetric.Energy - energia grawimetryczna,
  • Stability.Charge - stabilność w czasie ładowania,
  • Atomic.Fraction.Discharge - udział atomowy składników w stanie rozładowanym,
  • Atomic.Fraction.Charge - udział atomowy składników w stanie naładowanym.
predictors <- numeric_data %>%
  select(Gravimetric.Energy, Stability.Charge, Atomic.Fraction.Discharge, Atomic.Fraction.Charge)

response <- numeric_data$Volumetric.Energy

set.seed(123)
train_index <- createDataPartition(response, p = 0.8, list = FALSE)
train_data <- predictors[train_index, ]
test_data <- predictors[-train_index, ]
train_response <- response[train_index]
test_response <- response[-train_index]

model <- lm(train_response ~ ., data = as.data.frame(train_data))

Podsumowanie modelu

Podsumowanie współczynników modelu regresji liniowej
Współczynnik Szacunkowa wartość Błąd standardowy Statystyka t Wartość p
(Intercept) -176.170925 18.9096771 -9.316443 0
Gravimetric.Energy 2.992356 0.0349524 85.612423 0
Stability.Charge 2531.068883 95.3846901 26.535379 0
Atomic.Fraction.Discharge 2870.985836 187.7817116 15.288953 0
Atomic.Fraction.Charge -3135.947619 211.9263282 -14.797348 0

Porównanie predykcji energii i rzeczywistych wartości

predictions <- predict(model, newdata = as.data.frame(test_data))

results <- data.frame(
  Predicted = predictions,
  Actual = test_response
)

prediction_volum <- ggplot(results, aes(x = Actual, y = Predicted, 
                          text = paste("Rzeczywiste: ", round(Actual, 2), "<br>Przewidywane: ", round(Predicted, 2)))) +
  geom_point() +
  geom_abline(slope = 1, intercept = 0, color = "red") +
  labs(
    title = "Rzeczywiste a przewidywane wartości energii wolumetrycznej",
    x = "Rzeczywiste",
    y = "Przewidywane"
  ) +
  theme_minimal()

ggplotly(prediction_volum, tooltip = "text")

Ocena modelu

rmse <- sqrt(mean((results$Actual - results$Predicted)^2))
mae <- mean(abs(results$Actual - results$Predicted))
r_squared <- cor(results$Actual, results$Predicted)^2

Przedział energii wolumetrycznej: 2.4162556, 6199.8937472

Jest to bardzo szeroki zakres, co wskazuje na dużą zmienność gęstości energii w różnych przypadkach. Przewidzenie wartości z dużego przedziału wpłynęło na trudność zadania.

Jednak wartości metryk są obiecujące:

  • RMSE (Root Mean Square Error): 345.7721362
  • MAE (Mean Absolute Error): 249.6212039
  • R² (współczynnik determinacji): 0.8808561

Zwarzając na zakres rzeczywistej gęstości energii, uzyskane wartości RMSE oraz MAE świadczą o tym, że model radzi sobie stosunkowo dobrze, ale dla małych wartości może być mniej precyzyjny.

Zadowalający jest uzyskany współczynnik determinacji wynoszący 88.1%. Oznacza to, że model wyjaśnia większość zmienności zmiennej zależnej (energia wolumetryczna).

Możliwości ulepszenia

Można by było rozważyć zastosowanie technik takich jak standaryzacja lub transformacja danych, aby lepiej poradzić sobie z dużą zmiennością badanej cechy.

Również zastosowanie bardziej zaawansowanych modeli (np. modeli nieliniowych, zespołów drzew decyzyjnych) mogłoby poprawić predykcję.